home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Plus Special 22
/
AMIGAplus Sonderheft 22 (2000)(Falke)(DE)(Track 1 of 4)[!].iso
/
Rexx
/
LoadAnimGif.pprx
< prev
next >
Wrap
Text File
|
1999-11-06
|
8KB
|
295 lines
/* Personal Paint Amiga Rexx script - Copyright © 1996, 1997 Cloanto Italia srl */
/* $VER: LoadAnimGif.pprx 1.4 */
/** ENG
This script loads a GIF animation, and then either displays it with the
proper timing, or converts it into an IFF anim-brush (if the "Anim-Brush"
option is selected).
GIF animation features such as frame-by-frame timing, multiple palettes,
control blocks, offsets and overlays are supported. Multiple transparencies
are not supported.
*/
/** DEU
Mit Hilfe dieses Skripts läßt sich eine GIF-Animation laden und dann
entweder mit dem korrekten Timing anzeigen oder in einen IFF-Anim-Brush
konvertieren (sofern die Option "Anim-Brush" aktiviert ist).
Merkmale von GIF-Animationen, wie frameweises Timing, unterschiedliche
Paletten, Control Blocks, Offsets und Overlays werden unterstützt.
Unterschiedliche Transparenzwerte werden nicht unterstützt.
*/
/** ITA
Questo script carica un'animazione GIF, e poi o la visualizza con
un'adeguata temporizzazione, o la converte in un anim-brush IFF
(se l'opzione "Anim-Brush" è selezionata).
Sono riconosciute caratteristiche delle animazioni GIF come temporizzazione
fotogramma per fotogramma, tavolozze multiple, blocchi di controllo, offset
e sovrapposizioni. Non sono riconosciute trasparenze multiple.
*/
IF ARG(1, EXISTS) THEN
PARSE ARG PPPORT
ELSE
PPPORT = 'PPAINT'
IF ~SHOW('P', PPPORT) THEN DO
IF EXISTS('PPaint:PPaint') THEN DO
ADDRESS COMMAND 'Run >NIL: PPaint:PPaint'
DO 30 WHILE ~SHOW('P',PPPORT)
ADDRESS COMMAND 'Wait >NIL: 1 SEC'
END
END
ELSE DO
SAY "Personal Paint could not be loaded."
EXIT 10
END
END
IF ~SHOW('P', PPPORT) THEN DO
SAY 'Personal Paint Rexx port could not be opened'
EXIT 10
END
ADDRESS VALUE PPPORT
OPTIONS RESULTS
OPTIONS FAILAT 10000
Get 'LANG'
IF RESULT = 1 THEN DO /* Deutsch */
txt_title_req = 'GIF-Anim-Brush laden'
txt_gad_absh = 'Anim-_Brush:'
txt_err_oldclient = 'Für dieses Skript_ist eine neuere Version_von Personal Paint erforderlich'
txt_err_oldlib = 'Für dieses Skript ist eine neuere Version_der GIF library erforderlich'
txt_err_load = 'Fehler beim Laden'
txt_err_notagif = 'Die ausgewählte Datei enthält keine GIF-Animation'
txt_err_notsupp = 'Das ausgewählte Animationsformat kann nicht geladen werden.'
txt_err_scrfmt = 'Bildschirmformat kann nicht benutzt werden'
END
ELSE IF RESULT = 2 THEN DO /* Italiano */
txt_title_req = 'Leggere Anim-brush GIF'
txt_gad_absh = 'Anim-_Brush:'
txt_err_oldclient = 'Questa procedura richiede_una versione più recente_di Personal Paint'
txt_err_oldlib = 'Questa procedura richiede_una versione più recente_della libreria GIF'
txt_err_load = 'Errore nelle lettura del file'
txt_err_notagif = 'Il file selezionato_non contiene un''animazione GIF'
txt_err_notsupp = 'Il tipo di animazione non può essere letto'
txt_err_scrfmt = 'Il formato di schermo non può essere utilizzato'
END
ELSE DO /* English */
txt_title_req = 'Load GIF Anim-Brush'
txt_gad_absh = 'Anim-_Brush:'
txt_err_oldclient = 'This script requires a newer_version of Personal Paint'
txt_err_oldlib = 'This script requires a newer_version of the GIF library'
txt_err_load = 'Load error'
txt_err_notagif = 'The selected file_does not contain_a GIF animation'
txt_err_notsupp = 'The selected animation type_cannot be loaded'
txt_err_scrfmt = 'The screen format cannot be set'
END
Version 'REXX'
IF RESULT < 7 THEN DO
RequestNotify 'PROMPT "'txt_err_oldclient'"'
EXIT 10
END
LockGUI
RequestFile '"'txt_title_req'"'
IF RC = 0 THEN DO
gfile = RESULT
getbsh = LoadSet('GetBsh', 1)
Request '"'txt_title_req'" "CHECK = ""'txt_gad_absh'"", 'getbsh'"'
IF RC = 0 THEN DO
getbsh = RESULT.1
CALL SaveSet('GetBsh', getbsh)
frame = 1
loop = -1
delays = ''
err_msg = ''
setup = 1
Get 'GCLIP'
saveclip = RESULT
Set '"GCLIP=0"'
DO FOREVER
LoadBrush gfile 'QUIET NOPROGRESS FORMAT "GIF" OPTIONS "FRAME='frame'"'
IF RC = 0 THEN DO
IF setup THEN DO
setup = 0
SwitchEnvironment
FreeEnvironment 'QUERY'
IF RC ~= 0 THEN
LEAVE
DeleteFrames 'ALL FORCE'
SetPen 'BACKGROUND 0'
ClearImage
GetBrushAttributes 'COLORS'
cnum = RESULT
GetBrushAttributes 'WIDTH'
brushw = RESULT
GetBrushAttributes 'HEIGHT'
brushh = RESULT
IF SetScreenFormat(brushw, brushh, cnum, 1) ~= 0 THEN DO
IF SetScreenFormat(brushw, brushh, cnum, 0) ~= 0 THEN DO
err_msg = txt_err_scrfmt
LEAVE
END
END
GetBrushAttributes 'TRANSPARENCY'
transp = RESULT
GetBrushAttributes 'TRANSPARENTCOLOR'
transpcol = RESULT
SetPen 'BACKGROUND' transpcol
ClearImage
AddFrames
END
ELSE DO
GetBrushAttributes 'TRANSPARENCY'
transp2 = RESULT
GetBrushAttributes 'TRANSPARENTCOLOR'
transpcol2 = RESULT
IF transp2 ~= transp | transpcol2 ~= transpcol THEN DO
err_msg = txt_err_notsupp
LEAVE
END
END
UseBrushPalette
SetPaintMode 'REPLACE'
SetBrushAttributes 'HANDLEX 0 HANDLEY 0'
PutBrush 0 0
GetBrushInfo 'ANNOTATION'
IF RC = 0 THEN DO
PARSE VALUE RESULT WITH 'LOOP ' loop ' DELAY ' delay .
IF DATATYPE(delay, 'W') THEN DO
delays = delays delay
ticks = TRUNC(delay / 100 * 60 + 0.5)
SetFrameDelay ticks
END
END
AddFrames
SetFramePosition 'NEXT'
frame = frame + 1
END
ELSE DO
IF RC = 38 | (RC = 39 & frame <= 2) THEN
err_msg = txt_err_notagif
ELSE IF RC = 46 | RC = 47 THEN
err_msg = txt_err_oldlib
ELSE IF RC ~= 39 THEN
err_msg = txt_err_load
LEAVE
END
END
annot = ''
LoadBrush gfile 'QUIET NOPROGRESS' /* reset to normal load (AUTO) */
IF RC = 0 THEN DO
GetBrushInfo 'ANNOTATION'
IF RC = 0 THEN
annot = RESULT
END
FreeBrush 'FORCE'
DeleteFrames
IF err_msg ~= '' THEN DO
RequestNotify 'PROMPT "'err_msg'"'
FreeEnvironment 'FORCE'
END
ELSE DO
SetFramePosition 1
IF RC = 0 THEN DO
IF getbsh THEN DO
Get 'TRANSP'
sv_transp = RESULT
IF transp = 1 THEN
Set '"TRANSP=' transp '"'
ELSE
Set '"TRANSP=0"'
GetFrames
DefineBrush 0 0 brushw-1 brushh-1 RESULT
IF RC = 0 THEN DO
FreeEnvironment 'FORCE'
SetBrushInfo 'ANNOTATION "LOOP' loop 'DELAY' delays'"'
IF annot ~= '' THEN DO
pos = 1
DO FOREVER
pos = INDEX(annot, '"', pos)
IF pos = 0 THEN
BREAK
annot = INSERT('"', annot, pos)
pos = pos + 2
END
SetBrushInfo 'COPYRIGHT "'annot'"'
END
END
Set '"TRANSP=' sv_transp '"'
END
ELSE Play 'FORCE'
END
END
Set '"GCLIP='saveclip'"'
END
END
UnlockGUI
EXIT 0
SetScreenFormat: PROCEDURE
width = ARG(1)
height = ARG(2)
cnum = ARG(3)
IF ARG(4) ~= 0 THEN
GetBestVideoMode width height cnum 'ANIMATION'
ELSE
GetBestVideoMode width height cnum
IF RC = 0 THEN DO
PARSE VAR RESULT scrd scrw scrh
Set '"IMAGEW='width'" "IMAGEH='height'" "COLORS='cnum'" "DISPLAY='scrd'" "SCREENW='scrw'" "SCREENH='scrh'" "ASCROLL=0"'
END
RETURN RC
SaveSet: PROCEDURE
sname = ARG(1)
val = ARG(2)
IF OPEN('settingfile', 'ENV:PP_LoadAnimGIF_'sname, 'W') THEN DO
CALL WRITECH('settingfile', val)
CALL CLOSE('settingfile')
END
RETURN
LoadSet: PROCEDURE
sname = ARG(1)
val = ARG(2)
IF OPEN('settingfile', 'ENV:PP_LoadAnimGIF_'sname, 'R') THEN DO
val = READCH('settingfile', 65535)
CALL CLOSE('settingfile')
END
RETURN val